PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/win/pascal/ssavwin.exe/SSAVEPWD.PAS

Pascal/Delphi Source File | 1993-05-07 | 18.7 KB | 381 lines

Unit SSavePwd;

{****************************************************************************
*****************************************************************************
*                                                                           *
*  SSavePwd.pas:                                                            *
*  Unit for Windows 3.1 Screen Savers. Exports the types and functions      *
*  necessary for password handling.                                         *
*                                                                           *
*  Compiler: BP 7.0                                                         *
*                                                                           *
*  See SSaveDem.pas.                                                        *
*                                                                           *
*****************************************************************************
*                                                                           *
*  Copyright ⌐ 1993 Manfred Keul [100031,12].                               *
*                                                                           *
*  Rev. 0.1   28.3.93   MK  IR                                              *
*  Rev. 0.2    7.5.93   MK  EditNotify: New logic for enabling idc_EnaPWBut *
*                           No DefWndProc in WMActivate                     *
*                                                                           *
*****************************************************************************
****************************************************************************}


interface

uses Objects, OWindows, ODialogs, Wintypes, Winprocs, Encrypt;

{$I savepwrc.inc      contains rc constants }

const SaverName: PChar = 'Screen Saver.NoName';  { Default CONTROL.INI heading }

{****************************************************************************
*                                                                           *
*                        T P a s s W o r d D i a l o g                      *
*                                                                           *
*  Dialog box to input and enable the password.                             *
*                                                                           *
****************************************************************************}

type
   PPassWordDialog = ^TPassWordDialog;
   TPassWordDialog = object (TDialog)
       procedure SetupWindow; virtual;
       procedure OK (var Msg: TMessage); virtual id_First + id_OK;
       procedure Help (var Msg: TMessage); virtual id_First + idc_HelpBtn;
       procedure EditNotify1 (var Msg: TMessage); virtual id_First + idc_NewPW1;
       procedure EditNotify2 (var Msg: TMessage); virtual id_First + idc_NewPW2;
       procedure EditNotify (var Msg: TMessage); virtual;
     end;

{-----------  function returning "ok to close Screen Saver"  ---------------}

function PasswordOK (parent: PWindowsObject): boolean;

{****************************************************************************
*                                                                           *
*                         I m p l e m e n t a t i o n                       *
*                                                                           *
****************************************************************************}

implementation

{$R ssavepwd.res        contains password dialog layouts }

{****************************************************************************
*                                                                           *
*                           T S t o p D i a l o g                           *
*                                                                           *
*  Dialog box asking for password when Screen Saver stops.                  *
*                                                                           *
****************************************************************************}

type
   PStopDialog = ^TStopDialog;
   TStopDialog = object (TDialog)
       procedure SetupWindow; virtual;
       procedure OK (var Msg: TMessage); virtual id_First + id_OK;
       procedure WMActivate (var Msg: TMessage);virtual wm_first+WM_ACTIVATE;
     end;

{***************************************************************************}

const PWProtKeyName   = 'PWProtected';         { Headings in CONTROL.INI }
      PWStringKeyName = 'Password';
      PWStringHeading = 'ScreenSaver';

      PWDlgCaption    = 'Change Password';
      HelpCaption     = 'Password Help';
      MsgTxtNotFnd    = 'Message text not found.';
      StrgSize        = 255;
      HTSize          = 3 * StrgSize;
      PWSize          = 20;                   { Password size }

{***************************************************************************}

var  Text1:           array [0..HTSize] of char;       { general purpose..}
     Text2, Text3:    array [0..StrgSize] of char;     {..text buffers }

     CurrentPW:       array [0..PWSize] of char;       { copies of...}
     PWProtected:     word;                            {..CONTROL.INI values }


{****************************************************************************
*                                                                           *
*                         G e t P r o f i l e                               *
*                                                                           *
*   Reads screen saver entries from CONTROL.INI.                            *
*                                                                           *
*   INPUT:  SaverName = Heading of the private section of the saver in      *
*                    CONTROL.INI (something like: 'Screen Saver.savername') *
*                                                                           *
*   OUTPUT: Prot = 0 if password for this screen saver is disabled,         *
*                  <> 0 otherwise                                           *
*           PW   = Current password (from PWStringHeading entry )           *
*                                                                           *
****************************************************************************}

procedure GetProfile (var Prot: word; PW: PChar);
begin

Prot := GetPrivateProfileInt (SaverName, PWProtKeyName, 0, 'CONTROL.INI');

GetPrivateProfileString
   (PWStringHeading, PWStringKeyName, '', PW, PWsize+1, 'CONTROL.INI');

end;      { GetProfile }

{****************************************************************************
*                                                                           *
*                         P a s s w o r d O K                               *
*                                                                           *
*   Asks user to enter password.                                            *
*                                                                           *
*   INPUT:  parent = pointer to parent windows object.                      *
*           SaverName = Heading of the private section of the saver in      *
*                    CONTROL.INI (something like: 'Screen Saver.savername') *
*                                                                           *
*   OUTPUT: PasswordOK = true if entered password = password in CONTROL.INI *
*                            (or if saver currently not password protected) *
*                                                                           *
****************************************************************************}

function PasswordOK (parent: PWindowsObject): boolean;
begin
GetProfile (PWProtected, CurrentPW);
PasswordOK := true;
if ((PWProtected <> 0) and (CurrentPW [0] <> #0)) then
   PasswordOK := Application^.ExecDialog
                 (New (PStopDialog, Init(parent, 'StopDlg'))) = id_OK;
   { TStopDialog returns id_OK only if password was ok }
end; { Password OK }

{***************************************************************************}

{****************************************************************************
*                                                                           *
*              T S t o p D i a l o g . S e t u p W i n d o w                *
*                                                                           *
*   Limits text length in StopDialog's edit control idc_StopPW.             *
*                                                                           *
****************************************************************************}

procedure TStopDialog.SetupWindow ;
begin
inherited SetupWindow;
SendDlgItemMsg (idc_StopPW, EM_LimitText, PWSize, 0);
end;

{****************************************************************************
*                                                                           *
*              T S t o p D i a l o g . W M A c t i v a t e                  *
*                                                                           *
*   Sets focus in StopDialog to idc_StopPW, selects all its text.           *
*                                                                           *
****************************************************************************}

procedure TStopDialog.WMActivate (var Msg: TMessage);
begin
SetFocus (GetItemHandle (idc_StopPW));
SendDlgItemMsg (idc_StopPW, EM_SetSel, 0, $1000000); { $1000000 = end of line }
{ DefWndProc (Msg);  => wrong focus if edit control is empty  (Rev. 0.2) }
end;

{****************************************************************************
*                                                                           *
*                         T S t o p D i a l o g . O K                       *
*                                                                           *
*   Checks entered password; if ok, quits StopDialog.                       *
*                                                                           *
*   INPUT: CurrentPW = Current password (from CONTROL.INI)                  *
*                                                                           *
****************************************************************************}

procedure TStopDialog.OK (var Msg: TMessage);

var  OldPWInp: array [0..PWSize] of char;

begin
GetWindowText (GetItemHandle (idc_StopPW), OldPWInp, PWSize+1);  { user input }
EncryptString (OldPWInp);
if (lstrcmpi (OldPWInp, CurrentPW) <> 0) then      {  passwords match ? }
     begin                                         { if not,... }
     if (LoadString                         { try to load error message... }
               (HInstance, ids_Wrong, Text1, sizeof(Text1)-1) = 0) then
                    lstrcpy (Text1,MsgTxtNotFnd);
     GetWindowText (HWindow, Text2, sizeof(Text2));      {.. get caption.. }
     MessageBox (HWindow, Text1, Text2, MB_IconStop);
     exit;                                       {... and don't end dialog }
     end;   { if no match }
inherited OK (Msg);                          { ok: end dialog }
end;      { OK }

{***************************************************************************}

{****************************************************************************
*                                                                           *
*           T P a s s W o r d D i a l o g . S e t u p W i n d o w           *
*                                                                           *
*   Does some initialization work for the password entry dialog.            *
*                                                                           *
*   INPUT:  SaverName = Heading of the private section of the saver in      *
*                    CONTROL.INI (something like: 'Screen Saver.savername') *
*                                                                           *
*   OUTPUT: PWProtected = 0 if password for this screen saver is disabled,  *
*                         <> 0 otherwise                                    *
*           CurrentPW   = Current password (both from CONTROL.INI)          *
*                                                                           *
****************************************************************************}

procedure TPassWordDialog.SetupWindow;

begin

inherited SetupWindow;

{ read CONTROL.INI, set Enable button accordingly: }
GetProfile (PWProtected, CurrentPW);
CheckDlgButton (HWindow, idc_EnaPWBut, PWProtected);
EnableWindow (GetItemHandle (idc_EnaPWBut), (CurrentPW[0] <> #0));

{ if there is a current password, enable Old Password edit and static control: }
EnableWindow (GetItemHandle (idc_OldPWLbl), (CurrentPW[0] <> #0));
EnableWindow (GetItemHandle (idc_OldPW), (CurrentPW[0] <> #0));

{ Limit text length in edit controls to max. password length: }
SendDlgItemMsg (idc_OldPW, EM_LimitText, PWSize, 0);
SendDlgItemMsg (idc_NewPW1, EM_LimitText, PWSize, 0);
SendDlgItemMsg (idc_NewPW2, EM_LimitText, PWSize, 0);

end;   { SetupWindow }

{****************************************************************************
*                                                                           *
*           T P a s s W o r d D i a l o g . E d i t N o t i f y             *
*                                                                           *
*   Enables "Enable Password" checkbox, depending on New Password edits.    *
*                                                                           *
****************************************************************************}

procedure TPassWordDialog.EditNotify (var Msg: TMessage);
begin
if (Msg.LParamHi = EN_CHANGE) then              { is this a "change" notify? }
   { if so, enable checkbox if any of the passwords isn't blank: }
   EnableWindow (GetItemHandle (idc_EnaPWBut),
     ((CurrentPW[0] <> #0) or
      (SendDlgItemMsg (idc_NewPW1, WM_GetTextLength, 0, 0) > 0)) or
      (SendDlgItemMsg (idc_NewPW2, WM_GetTextLength, 0, 0) > 0));
Msg.Result := 0;
end;   { EditNotify }

{ two frontends for EditNotify - one for each edit control: }

procedure TPassWordDialog.EditNotify1 (var Msg: TMessage);
begin
EditNotify (Msg);
end;

procedure TPassWordDialog.EditNotify2 (var Msg: TMessage);
begin
EditNotify (Msg);
end;

{****************************************************************************
*                                                                           *
*               T P a s s W o r d D i a l o g . O K                         *
*                                                                           *
*   Ends password entry dialog if all entries are acceptable.               *
*                                                                           *
*   INPUT: CurrentPW = Current password (from CONTROL.INI)                  *
*          SaverName = Heading of the private section of the saver in       *
*                    CONTROL.INI (something like: 'Screen Saver.savername') *
*                                                                           *
****************************************************************************}

procedure TPassWordDialog.OK (var Msg: TMessage);

const WriteError: PChar =
        'Couldn''t write CONTROL.INI. Settings probably not saved.';

var  OldPWInp, NewPWInp1, NewPWInp2: array [0..PWSize] of char;
     OldInpL, NewInp1L, NewInp2L: integer;

begin

{ read the three edit controls: }
OldInpL  := GetWindowText (GetItemHandle (idc_OldPW), OldPWInp, PWSize+1);
NewInp1L := GetWindowText (GetItemHandle (idc_NewPW1), NewPWInp1, PWSize+1);
NewInp2L := GetWindowText (GetItemHandle (idc_NewPW2), NewPWInp2, PWSize+1);

if (OldInpL+NewInp1L+NewInp2L <> 0) then        { all three blank? }
    begin                                       { if not...}
    if (CurrentPW [0] <> #0) then          {..and there is currently a PW.. }
       begin
       EncryptString (OldPWInp);                       { encrypt user input }
       if (lstrcmpi (OldPWInp, CurrentPW) <> 0) then    { check against old }
         begin                                  { error message if no match }
         if (LoadString
               (HInstance, ids_WrongOld, Text1, sizeof(Text1)-1) = 0) then
           lstrcpy (Text1,MsgTxtNotFnd);
         MessageBox (HWindow, Text1, PWDlgCaption, MB_IconStop);
         exit;                                   { don't end dialog }
         end;  { if lstrcmpi }
       end;  { if CurrentPW }

    { correct old PW was entered (or currently no PW) }
    if (lstrcmpi (NewPWInp1, NewPWInp2) <> 0) then    { do new PW's match? }
        begin                                       { error message if not }
        if (LoadString
              (HInstance, ids_WrongNew, Text1, sizeof(Text1)-1) = 0) then
          lstrcpy (Text1,MsgTxtNotFnd);
        MessageBox (HWindow, Text1, PWDlgCaption, MB_IconStop);
        exit;                                   { don't end dialog }
        end;   { if lstrcmpi }

    { PW entries are ok }
    EncryptString (NewPWInp1);

    if not WritePrivateProfileString   { store encrypted new PW in CONTROL.INI }
            (PWStringHeading, PWStringKeyName, NewPWInp1, 'CONTROL.INI') then
       MessageBox (HWindow, WriteError, PWDlgCaption, MB_IconStop);

    end; { if all three...}

{ all PW entries ok - or currently no PW }
Text1 [0] := char ($30 + IsDlgButtonChecked (HWindow, IDC_EnaPWBut));
Text1 [1] := #0;                                { => Text1 := '0' or '1' }
if not WritePrivateProfileString     { write PW-enable-status into CONTROL.INI }
        (SaverName, PWProtKeyName, Text1, 'CONTROL.INI') then
   MessageBox (HWindow, WriteError, PWDlgCaption, MB_IconStop);
WritePrivateProfileString (nil, nil, nil, 'CONTROL.INI'); { flush buffers }

inherited OK (Msg);
end;      { OK }

{****************************************************************************
*                                                                           *
*                 T P a s s W o r d D i a l o g . H e l p                   *
*                                                                           *
*   Loads and displays help text for password entry dialog.                 *
*                                                                           *
****************************************************************************}

procedure TPassWordDialog.Help (var Msg: TMessage);
begin
if (LoadString (HInstance, ids_PWHelp1, Text1, sizeof(Text1)-1) = 0) then
   exit;
if (LoadString (HInstance, ids_PWHelp2, Text2, sizeof(Text2)-1) = 0) then
   exit;
if (LoadString (HInstance, ids_PWHelp3, Text3, sizeof(Text3)-1) = 0) then
   exit;
lstrcat (lstrcat (Text1,Text2), Text3);
MessageBox (HWindow, Text1, HelpCaption, MB_IconInformation);
end;


begin
end.